home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Hyper / Q-R / REgion.cpt / Region Buttons / card_9446.txt < prev    next >
Text File  |  1987-11-07  |  12KB  |  360 lines
  1. -- card: 9446 from stack: in
  2. -- bmap block id: 0
  3. -- flags: 0000
  4. -- background id: 3256
  5. -- name: Source Code
  6.  
  7.  
  8. -- part contents for background part 1
  9. ----- text -----
  10. {$R-}
  11.  
  12. {**************************************************************************
  13.   Button Regions
  14.   by Keith Rollin
  15.   October, 1987
  16.   ¬© Apple Computer, Inc.
  17.   All Rights Reserved
  18.  
  19.   This XCMD is an example of how to implement buttons in HyperCard that
  20.   are shaped as regions. This is facilitated by the use of 3 commands:
  21.  
  22.   NewRgn     - Create the buttons, draws them on the screen, passes
  23.                a handle back to the HyperCard script.
  24.   TestHit    - Tests the buttons against the mouse location. Returns
  25.                the number of the button hit, or zero if none.
  26.   DisposeRgn - Removes the button descriptions from memory. MUST be
  27.                called before the stack is left.
  28. ***************************************************************************}
  29.  
  30. {$S ButtonRgn } { Segment name must be the same as the command name. }
  31.  
  32. UNIT DummyUnit;
  33.  
  34.   INTERFACE
  35.  
  36.     USES {$Load Rgn.sym} MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXcmd;
  37.  
  38.     PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  39.  
  40. {
  41. ***************************************************************************
  42. }
  43.  
  44.   IMPLEMENTATION
  45.  
  46.     CONST
  47.       NUMBER_OF_BUTTONS = 4;
  48.  
  49.     TYPE
  50.       Str31 = String[31];
  51.       RgnArray = ARRAY [1..1] OF RgnHandle;
  52.       ArrayPtr = ^RgnArray;
  53.       ArrayHandle = ^ArrayPtr;
  54.  
  55. {***************************************************************************
  56.  This arcane sequence of instructions is required for any sort of
  57.  'vanilla' code resource that doesn't have a jump table. For things
  58.  like FKEYs, INITs, and XCMDs, the entry point must be at the beginning
  59.  of the resource.
  60.  ***************************************************************************}
  61.  
  62.     PROCEDURE ButtonRgn(paramPtr: XCmdPtr);
  63.       FORWARD;
  64.  
  65.     PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  66.  
  67.       BEGIN
  68.         ButtonRgn(paramPtr);
  69.       END;
  70.  
  71.     PROCEDURE ButtonRgn(paramPtr: XCmdPtr);
  72.  
  73.       VAR
  74.         flashCount: LongInt;
  75.         i: INTEGER;
  76.         port: GrafPtr;
  77.         str: Str255;
  78.  
  79.         {$I XCmdGlue.inc }
  80.  
  81. {***************************************************************************
  82.  ParmStr - Returns the nth parameter passed to the XCMD in string form
  83.  ***************************************************************************}
  84.  
  85.       FUNCTION ParmStr(parmnum: INTEGER): Str255; {return text of parm#}
  86.  
  87.         VAR
  88.           str: Str255;
  89.  
  90.         BEGIN
  91.           ZeroToPas(paramPtr^.params[parmnum]^, str);
  92.           ParmStr := str;
  93.         END;
  94.  
  95. {***************************************************************************
  96.  ParmVal - Returns the nth parameter passed to the XCMD in numeric form
  97.  ***************************************************************************}
  98.  
  99.       FUNCTION ParmVal(parmnum: INTEGER): LongInt;
  100.  
  101.         VAR
  102.           str: Str255;
  103.           tHandle: handle;
  104.  
  105.         BEGIN
  106.           tHandle := EvalExpr(ParmStr(parmnum)); {evaluate the string}
  107.           ZeroToPas(tHandle^, str); {convert the [string] value to a longint}
  108.           ParmVal := StrToNum(str);
  109.           DisposHandle(tHandle);
  110.         END;
  111.  
  112. {***************************************************************************
  113.  NewButton - Responsible for the creation of all the buttons. Accepts
  114.  as input the button number to create, and returns a RgnHandle to that
  115.  button.
  116.  ***************************************************************************}
  117.  
  118.       FUNCTION NewButton(buttonNum: INTEGER): RgnHandle;
  119.  
  120.         VAR
  121.           tRgn, tRgn2: RgnHandle;
  122.           tRect: rect;
  123.  
  124.         BEGIN
  125.           CASE buttonNum OF
  126.             1: BEGIN
  127.               tRgn := NewRgn;
  128.               OpenRgn;
  129.               SetRect(tRect, 72, 164, 152, 215);
  130.               FrameRect(tRect);
  131.               CloseRgn(tRgn);
  132.             END;
  133.             2: BEGIN
  134.               tRgn := NewRgn;
  135.               OpenRgn;
  136.               SetRect(tRect, 240, 165, 359, 213);
  137.               FrameOval(tRect);
  138.               CloseRgn(tRgn);
  139.             END;
  140.             3: BEGIN
  141.               tRgn := NewRgn;
  142.               OpenRgn;
  143.               SetRect(tRect, 146, 224, 200, 284);
  144.               FrameRoundRect(tRect, 16, 16);
  145.               CloseRgn(tRgn);
  146.               tRgn2 := NewRgn;
  147.               OpenRgn;
  148.               MoveTo(173, 270);
  149.               LineTo(156, 305);
  150.               LineTo(190, 305);
  151.               LineTo(173, 270);
  152.               CloseRgn(tRgn2);
  153.               UnionRgn(tRgn, tRgn2, tRgn);
  154.               DisposeRgn(tRgn2);
  155.             END;
  156.             4: BEGIN
  157.               tRgn := NewRgn;
  158.               OpenRgn;
  159.               MoveTo(337, 230);
  160.               LineTo(280, 290);
  161.               LineTo(394, 290);
  162.               LineTo(337, 230);
  163.               SetRect(tRect, 280, 230, 300, 250);
  164.               FrameRect(tRect);
  165.               SetRect(tRect, 374, 230, 394, 250);
  166.               FrameRect(tRect);
  167.               CloseRgn(tRgn);
  168.             END;
  169.           END;
  170.           NewButton := tRgn;
  171.         END;
  172.  
  173. {***************************************************************************
  174.  doNewRgn - Creates a handle to an array of handles large enough to hold
  175.  NUMBER_OF_BUTTONS region handles. Then calls NewButton NUMBER_OF_BUTTONS
  176.  times to fetch the handles to each button. Draws the buttons to the
  177.  screen and returns the handle to the array in a specified global
  178.  variable.
  179.  ***************************************************************************}
  180.  
  181.       PROCEDURE doNewRgn; {Create a New set of region(s) and plot them}
  182.  
  183.         VAR
  184.           ButtonPict: PicHandle;
  185.           result: LongInt;
  186.           tHandle: handle;
  187.           str: Str255;
  188.           MyArray: ArrayHandle;
  189.           BigRect: rect;
  190.           i: INTEGER;
  191.  
  192.         BEGIN
  193.  
  194.           { Create all the buttons, and store their handles in MyArray }
  195.  
  196.           MyArray := ArrayHandle(NewHandle(NUMBER_OF_BUTTONS * 4));
  197.           HLock(handle(MyArray));
  198.           FOR i := 1 TO NUMBER_OF_BUTTONS DO BEGIN
  199.             MyArray^^[i] := NewButton(i);
  200.           END;
  201.  
  202.           { Get a rectangle that includes all the buttons.}
  203.  
  204.           BigRect := MyArray^^[1]^^.rgnBBox;
  205.           IF i > 1 THEN
  206.             FOR i := 2 TO NUMBER_OF_BUTTONS DO BEGIN
  207.               UnionRect(BigRect, MyArray^^[i]^^.rgnBBox, BigRect);
  208.             END;
  209.  
  210.           { Create a picture that plots all the buttons }
  211.  
  212.           ButtonPict := OpenPicture(BigRect);
  213.           FOR i := 1 TO NUMBER_OF_BUTTONS DO BEGIN
  214.             FrameRgn(MyArray^^[i]);
  215.           END;
  216.           ClosePicture;
  217.  
  218.           {Put the picture on the Clipboard for HyperCard to find}
  219.  
  220.           HLock(handle(ButtonPict));
  221.           result := ZeroScrap;
  222.           result := PutScrap(GetHandleSize(handle(ButtonPict)), 'PICT',
  223.                              ptr(ButtonPict^));
  224.           HUnlock(handle(ButtonPict));
  225.           KillPicture(ButtonPict);
  226.  
  227.           IF result <> noErr THEN BEGIN
  228.             paramPtr^.returnValue := PasToZero('Error: Creating buttons');
  229.             DisposHandle(handle(MyArray));
  230.           END
  231.           ELSE BEGIN
  232.             SendCardMessage('Type "V" with commandkey');
  233.             SendCardMessage('Choose browse tool');
  234.             ZeroToPas(paramPtr^.params[1]^, str);
  235.             tHandle := PasToZero(LongToStr(LongInt(MyArray)));
  236.             SetGlobal(str, tHandle);
  237.             DisposHandle(tHandle);
  238.             HUnlock(handle(MyArray));
  239.           END;
  240.         END;
  241.  
  242. {***************************************************************************
  243.  doTestHit - Accepts a mouse location and optional boolean value. The
  244.  mouse location is checked against all the button regions for a hit. If
  245.  there is a hit, the button number is returned in 'the result'. If there
  246.  is no hit, button number zero is returned. The optional boolean value
  247.  determines whether or not the button is hilighted when hit. If the
  248.  booleam value is not specified, then it defaults to FALSE.
  249.  ***************************************************************************}
  250.  
  251.       PROCEDURE doTestHit;
  252.  
  253.         VAR
  254.           mouseLoc: point;
  255.           MyArray: ArrayHandle;
  256.           ButtonPict: PicHandle;
  257.           result: LongInt;
  258.           str: Str255;
  259.           hit: boolean;
  260.  
  261.         BEGIN
  262.           {Get the mouse location and data handle}
  263.           mouseLoc.h := ParmVal(3);
  264.           mouseLoc.v := ParmVal(4);
  265.           MyArray := ArrayHandle(ParmVal(1));
  266.           HLock(handle(MyArray));
  267.  
  268.           {loop to see if the mouseloc falls into any regions}
  269.           i := 0;
  270.           hit := FALSE;
  271.           REPEAT
  272.             i := i + 1;
  273.             hit := PtInRgn(mouseLoc, MyArray^^[i]);
  274.           UNTIL (i = NUMBER_OF_BUTTONS) OR hit;
  275.  
  276.           {It does, so return the button number, and hilight it if necessary}
  277.           IF hit THEN BEGIN
  278.             paramPtr^.returnValue := PasToZero(NumToStr(i)); {return button#}
  279.             IF paramPtr^.paramcount = 5 THEN BEGIN {do highlighting?}
  280.               ZeroToPas(paramPtr^.params[5]^, str);
  281.               IF StrToBool(str) THEN BEGIN {yes, do the hilighting}
  282.                 HLock(handle(MyArray^^[i]));
  283.                 ButtonPict := OpenPicture(MyArray^^[i]^^.rgnBBox);
  284.                 InvertRgn(MyArray^^[i]);
  285.                 ClosePicture;
  286.                 result := ZeroScrap;
  287.                 result := PutScrap(GetHandleSize(handle(ButtonPict)), 'PICT',
  288.                                    ptr(ButtonPict^));
  289.                 KillPicture(ButtonPict);
  290.                 HUnlock(handle(MyArray^^[i]));
  291.                 HUnlock(handle(MyArray)); {don't need this locked anymore}
  292.                 IF result = noErr THEN BEGIN
  293.                   SendCardMessage('type "V" with commandkey');
  294.  
  295.                   { There may be a problem with the above step. If you
  296.                     have a measly 1 meg, there may not be enough memory
  297.                     for HyperCard to use the painting tools. It will
  298.                     get into a viscous loop, complaining that there
  299.                     is not enough room, until crashing with an ID=28. I
  300.                     was able to relieve the problem by unlocking the
  301.                     handle to MyArray 3 lines up instead of at the end of
  302.                     the procedure, but it still indicates that there is
  303.                     very little room left when painting.}
  304.  
  305.                   SendCardMessage('type "Z" with commandkey');
  306.                   SendCardMessage('choose browse tool');
  307.                 END; {if picture was create OK}
  308.               END; {if param[5] = TRUE}
  309.             END; {if paramcount = 5}
  310.           END {if PtInRgn}
  311.           ELSE BEGIN
  312.             paramPtr^.returnValue := PasToZero('0')
  313.           END;
  314.           HUnlock(handle(MyArray));
  315.         END;
  316.  
  317. {***************************************************************************
  318.  doDispose - Removes the buttons from memory. Loops through the array
  319.  of region handles, removing them one by one. Then disposes the handle
  320.  to that array.
  321.  ***************************************************************************}
  322.  
  323.       PROCEDURE doDispose;
  324.  
  325.         VAR
  326.           MyArray: ArrayHandle;
  327.           i: INTEGER;
  328.  
  329.         BEGIN
  330.           MyArray := ArrayHandle(ParmVal(1));
  331.           HLock(handle(MyArray));
  332.           IF (MyArray <> NIL) THEN BEGIN
  333.             FOR i := 1 TO NUMBER_OF_BUTTONS DO BEGIN
  334.               DisposeRgn(MyArray^^[i]);
  335.             END;
  336.             DisposHandle(handle(MyArray));
  337.             SendCardMessage(concat('put empty into ', ParmStr(1)));
  338.           END;
  339.         END;
  340.  
  341. {***************************************************************************
  342.  Main Routine - Checks the second parameter to see what routine to
  343.  call and calls it.
  344.  ***************************************************************************}
  345.  
  346.       BEGIN
  347.         ZeroToPas(paramPtr^.params[2]^, str);
  348.         IF StringEqual(str, 'NewRgn') THEN
  349.           doNewRgn
  350.         ELSE IF StringEqual(str, 'TestHit') THEN
  351.           doTestHit
  352.         ELSE IF StringEqual(str, 'DisposeRgn') THEN doDispose;
  353.       END;
  354.  
  355. END.
  356.  
  357.  
  358. -- part contents for background part 9
  359. ----- text -----
  360. 98